home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 3 / CD ACTUAL 3.iso / linux / incoming / jstools-.6v3 / jstools- / jstools-tk3.6v3.0 / lib / jmetawidgets.tcl < prev    next >
Encoding:
Text File  |  1995-02-09  |  5.3 KB  |  183 lines
  1. # jmetawidgets.tcl - compound pseudo-widgets that can be packed
  2. # 
  3. # Copyright 1992-1994 by Jay Sekora.  All rights reserved, except 
  4. # that this file may be freely redistributed in whole or in part 
  5. # for non-profit, noncommercial use.
  6. ######################################################################
  7.  
  8. ### TO DO
  9. ###   j:buttonbar:button to add a button to the buttonbar
  10. ###   make metawidgets create a widget command like real widgets
  11. ###   make metawidgets understand `-configure'
  12.  
  13. ######################################################################
  14. # metawidget options:
  15. #
  16. option add *Rule.relief sunken widgetDefault
  17. option add *Rule.width 2 widgetDefault
  18. option add *Rule.height 2 widgetDefault
  19. option add *Rule.borderWidth 1 widgetDefault
  20. option add *Filler.relief flat widgetDefault
  21. option add *Filler.width 10 widgetDefault
  22. option add *Filler.height 10 widgetDefault
  23. #
  24. ######################################################################
  25.  
  26.  
  27. ######################################################################
  28. # j:buttonbar w ?options? - make a buttonbar packed in w
  29. # options are:
  30. #   -default (default none)
  31. #   -padx (default 5)
  32. #   -pady (default 5)
  33. #   -orient (default horizontal)
  34. #   -buttons (default {})
  35. # syntax of button list is {{name text command} ... }
  36. ######################################################################
  37.  
  38. proc j:buttonbar {args} {
  39.   j:parse_args {
  40.     {default "(NONE)"}
  41.     {padx 5}
  42.     {pady 5}
  43.     {orient horizontal}
  44.     buttons
  45.   }
  46.  
  47.   if {[llength $args] != 1} {
  48.     tkerror {Improper arguments}
  49.   }
  50.   
  51.   set newframe [lindex $args 0]
  52.   
  53.   if {$orient == "horizontal"} {
  54.     set side right                ;# for packing
  55.   } else {
  56.     set side bottom                ;# for packing
  57.   }
  58.  
  59.   frame $newframe
  60.   if {$padx} {
  61.     pack [j:filler $newframe -width $padx] -in $newframe -side left
  62.     pack [j:filler $newframe -width $padx] -in $newframe -side right
  63.   }
  64.   if {$pady} {
  65.     pack [j:filler $newframe -height $pady] -in $newframe -side top
  66.     pack [j:filler $newframe -height $pady] -in $newframe -side bottom
  67.   }
  68.   
  69.   foreach i $buttons {
  70.     set name [lindex $i 0]
  71.     set text [lindex $i 1]
  72.     set command [lindex $i 2]
  73.  
  74.     set width [expr {[string length $text] + 1}]    
  75.     if {$width < 8} {set width 8}
  76.     
  77.     set button $newframe.$name
  78.     button $button -width $width -text $text -command $command
  79.     set border $newframe.border_$name
  80.     frame $border -relief flat -borderwidth 1
  81.     raise $button
  82.     pack $button -in $border -padx 2 -pady 2
  83.     pack $border -in $newframe -side $side -padx 2
  84.     if [string match $default $name] {
  85.       $border configure -relief sunken
  86.     }
  87.   }
  88.   return $newframe
  89. }
  90.  
  91. ######################################################################
  92. # j:colour_chooser w ?options? - create a metawidget for selecting colors
  93. # options include
  94. #   -label (default "Colour:")
  95. #   -variable (global variable to set - not really optional)
  96. ### SHOULD SUPPORT -padx and -pady
  97. ######################################################################
  98.  
  99. proc j:colour_chooser { w args } {
  100.   j:parse_args { {label "Colour:"} {variable j_prefs_colour} }
  101.   
  102.   set array_or_variable [lindex [split $variable "("] 0]
  103.   
  104.   global $array_or_variable
  105.   
  106.   append $variable {}
  107.   if {[set $variable] == {} } then {set $variable "#a8a8a8"} ;# bisque
  108.  
  109.   frame $w
  110.   
  111.   label $w.label -anchor e -text $label
  112.   
  113.   button $w.patch -background [set $variable] -width 4
  114.   
  115.   button $w.rgb -width 8 -text "RGB" -command "
  116.     set $variable \[j:prompt_colour_rgb\]
  117.     $w.patch configure -background \[set $variable\]
  118.   "
  119.   button $w.name -width 8 -text "Name" -command "
  120.     set $variable \[j:prompt_colour_name\]
  121.     $w.patch configure -background \[set $variable\]
  122.   "
  123.   
  124.   pack [j:filler $w] -in $w -side top -fill x
  125.   pack [j:filler $w] -in $w -side bottom -fill x
  126.   pack [j:filler $w] $w.name [j:filler $w] $w.rgb [j:filler $w] \
  127.      $w.patch [j:filler $w] \
  128.     -in $w -side right
  129.   pack $w.label -side right -expand yes -fill x
  130.   
  131.   return $w
  132. }
  133.  
  134. proc j:color_chooser \
  135.   [info args j:colour_chooser] \
  136.   [info body j:colour_chooser]
  137.  
  138. ######################################################################
  139. # j:variable_entry w ?options? - labelled entry for global variable
  140. # options include
  141. #   -label (default "Value:")
  142. #   -variable (default value - not really optional)
  143. #   -labelwidth (default 16)
  144. #   -entrywidth (default 40)
  145. #   -labelconfig (default "")
  146. #   -entryconfig (default "")
  147. # labelconfig and entryconfig are lists of additional configuration
  148. #   options to control the appearance of the label and the entry
  149. # BOGUSNESS:  you need to know that the entry is $newframe.e
  150. #   in order to bind to it!
  151. ######################################################################
  152.  
  153. proc j:variable_entry {args} {
  154.   j:parse_args {
  155.     {label {Value:} }
  156.     {variable value }
  157.     {labelwidth {16} }
  158.     {entrywidth {40} }
  159.     {labelconfig {} }
  160.     {entryconfig {} }
  161.   }
  162.   global $variable
  163.  
  164.   set newframe [lindex $args 0]
  165.   
  166.   frame $newframe
  167.   set l $newframe.l
  168.   set e $newframe.e
  169.   label $l -text $label -width $labelwidth -anchor e
  170.   entry $e -relief sunken -width $entrywidth -textvariable $variable
  171.   
  172.   if {$labelconfig != ""} {
  173.     eval $l configure $labelconfig
  174.   }
  175.   if {$entryconfig != ""} {
  176.     eval $e configure $entryconfig
  177.   }
  178.   pack $l -in $newframe -side left -fill both
  179.   pack $e -in $newframe -side left -fill both
  180.   
  181.   return $newframe
  182. }
  183.